home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADLIST.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.7 KB  |  112 lines
  1. 2  RUN "ADMAIN.BAS"
  2. 1300  COLOR 14,0:LOCATE 22,50:PRINT "KEY  F1";:COLOR 3,0:PRINT " = MAIN MENU":LOCATE 1,1:RETURN
  3. 1310  CLS:LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$:COLOR 3,0:LOCATE 1,1:RETURN
  4. 1315  LOCATE 25,10:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";SPACE$(15);"SERIAL NUMBER: ";SNN$;:COLOR 3,0:RETURN
  5. 1400  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  6. 1410  INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  7. 1500  OPEN FILM$ FOR INPUT AS #3
  8. 1510  INPUT #3,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:CLOSE #3
  9. 1515  DIM V$(16),D$(NN+2),C(NN+2),V(2,NN)
  10. 1520  OPEN FILE$ AS #4 LEN = 356
  11. 1525  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  12. 1530  GET #4,NN+1:K=VAL(V$(16)):IK=0
  13. 1535  IF IK=>NN THEN RETURN ELSE IK=IK+1:GET #4,K
  14. 1540  C(K)=VAL(V$(16)):V(1,K)=VAL(V$(1)):V(2,K)=VAL(V$(2)):D$(K)=MID$(V$(2),5,V(2,K))+MID$(V$(1),5,V(1,K)):
  15. 1545  K=VAL(V$(14)):GOTO 1535
  16. 1562  RETURN
  17. 4500  REM
  18. 4510  X1$="SELECT PRINTER":X3$="FILE = ":X5$="FUNCTION = ":X4$=SPACE$(10):Q$=CHR$(27)
  19. 4520  IF AX$="***" THEN T1$="    THE ISS PERSONAL ADDRESS BOOK"
  20. 4540  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #2:RETURN
  21. 4545  IF PT$="N" THEN OPEN "LPT2:" FOR OUTPUT AS #2:RETURN
  22. 4550  GOSUB 1310:GOSUB 1300:PRINT "PLEASE SELECT PRINTER:  " :PRINT
  23. 4570  COLOR 14,0:PRINT :PRINT "   ";CHR$(186);"     ";O$:PRINT "   ";CHR$(186);"     ";O1$:PRINT "   ";CHR$(25);"     ";O2$:COLOR 3,0
  24. 4580  PRINT :LOCATE  8,4:PRINT "I)BM Parallel Printer":LOCATE 9,4:PRINT "N)Serial Printer":COLOR 14,0:LOCATE 8,4:PRINT "I":LOCATE 9,4:PRINT "N"
  25. 4590  COLOR 31,0:LOCATE 5,11:PRINT "?":COLOR 3,0
  26. 4592  GOSUB 1300
  27. 4595  GOSUB 10020:DEF SEG=0: POKE 1050, PEEK(1052)
  28. 4600  PT$=INKEY$: IF PT$="" THEN 4600 ELSE PT$=CHR$(ASC(PT$) AND &HDF)
  29. 4610  IF PT$="N" THEN 4630
  30. 4620  IF PT$="I" THEN 4630 ELSE 4595
  31. 4630  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #2:GOTO 4635
  32. 4632  OPEN "LPT2:" FOR OUTPUT AS #2
  33. 4635  X1$="SELECT TITLE":GOSUB 1310
  34. 4640  PRINT "PLEASE CHOOSE THE HEADING FOR YOUR ADDRESS BOOK.":PRINT
  35. 4660  COLOR 14,0:PRINT :PRINT "   ";CHR$(186);"     ";O$:PRINT "   ";CHR$(186);"     ";O1$:PRINT "   ";CHR$(25);"     ";O2$:COLOR 3,0
  36. 4670  PRINT :LOCATE 8,4:PRINT "S)TORED title - ":LOCATE 8,20:COLOR 14,0:PRINT T1$:COLOR 3,0:LOCATE 9,4:PRINT "N)EW title"
  37. 4675  COLOR 14,0:LOCATE 8,4:PRINT "S":LOCATE 9,4:PRINT "N"
  38. 4680  COLOR 31,0:LOCATE 5,11:PRINT "?":COLOR 3,0
  39. 4682  GOSUB 1300
  40. 4685  GOSUB 10020:DEF SEG=0: POKE 1050, PEEK(1052)
  41. 4690  Y$=INKEY$: IF Y$="" THEN 4690
  42. 4700  IF Y$="N" OR Y$="n" THEN 4720
  43. 4710  IF Y$="S" OR Y$="s" THEN 4780 ELSE 4685
  44. 4720  GOSUB 1310
  45. 4730  PRINT "Please INPUT the TITLE of your ADDRESS BOOK (maximum length THIRTY-TWO (32)           characters long)":GOSUB 1300:GOSUB 10010:LOCATE 12,15:INPUT "TITLE ... ",T$:T1$=LEFT$(T$,32)
  46. 4780  X1$="PRINT PARAMETERS":GOSUB 1310
  47. 4790  PRINT "PLEASE SELECT PRINTER VARIABLES:  ":PRINT:GOSUB 1300
  48. 4800  LOCATE 4,2:PRINT "What is the length of your paper (in INCHES)?  ";:GOSUB 10010:INPUT " ",LP1
  49. 4810  LOCATE 6,2:PRINT "Do you want to be prompted when printing reaches the end of the page?":LOCATE 7,4: PRINT "ENTER <";:COLOR 14,0:PRINT "Y";:COLOR 3,0:PRINT ">es or <";:COLOR 14,0:PRINT "N";:COLOR 3,0:PRINT ">o."
  50. 4815  GOSUB 10020:DEF SEG=0: POKE 1050, PEEK(1052)
  51. 4820  LP$=INKEY$: IF LP$="" THEN 4820 ELSE LP$=CHR$(ASC(LP$) AND &HDF)
  52. 4822  IF LP$="Y" OR  LP$="N" THEN RETURN ELSE 4815
  53. 6000  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 1,67:PRINT "(C) 1983":LOCATE 2,62:PRINT "Date:  ";DATE$:LOCATE 3,62:PRINT "Time:  "
  54. 6010  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 6010 ELSE RETURN
  55. 6040  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 19,29:PRINT "Date:  ";DATE$:LOCATE 20,29:PRINT "Time:  ":GOSUB 10000
  56. 6050  LOCATE ,,0:Y$=INKEY$:IF Y$="" THEN LOCATE 20,36:PRINT TIME$:GOTO 6050 ELSE RETURN
  57. 6085  DEF SEG=0: POKE 1050, PEEK(1052):LOCATE 20,29:PRINT "Date:  ";DATE$:LOCATE 21,29:PRINT "Time:  ";TIME$:RETURN
  58. 7000  ON ERROR GOTO 2:ON KEY(1) GOSUB 2:KEY(1) ON:CLS:GOSUB 1315:GOSUB 1300
  59. 7001  LOCATE 8,25:PRINT "Please Wait.  Reading Names."
  60. 7004  GOSUB 1400
  61. 7008  LOCATE 12,20:PRINT "Please Wait.  Sorting Names before printing.";
  62. 7010  G=NN
  63. 7020  WHILE G>1
  64. 7025  G=INT(G/2):MX=NN-G:PRINT " . ";:SOUND 523,1
  65. 7030  F=0
  66. 7035  FOR I=1 TO MX:P=I+G
  67. 7040  IF D$(I)<=D$(P) THEN 7050
  68. 7045  SWAP D$(P),D$(I):SWAP C(P),C(I):SWAP V(1,P),V(1,I):SWAP V(2,P),V(2,I):F=1
  69. 7050  NEXT
  70. 7055  IF F>0 THEN 7030
  71. 7060  WEND
  72. 7065  GOSUB 4500
  73. 7070  TN=LEN(T1$)
  74. 7080  TN=INT((70-TN)/2 +0.5)
  75. 7085  CLS:GOSUB 1315:COLOR 0,7:LOCATE 12,26:PRINT "Turn on printer and hit any key.":GOSUB 1300
  76. 7086  Y$=INKEY$:IF Y$="" THEN 7086
  77. 7087  LOCATE 12,26:PRINT SPACE$(40):LOCATE 12,31:COLOR 16,7:PRINT "WORKING":COLOR 3,0
  78. 7089  GOSUB 7500
  79. 7090  NM=INT(NN/2+0.5)
  80. 7092  MP1=LP1*6-9:K=1
  81. 7100  FOR I= 1 TO NM
  82. 7101  IF MP<MP1 THEN 7110 ELSE K=K+1
  83. 7102  IF LP$="N" OR LP$="n" THEN 7105 ELSE PRINT "Advance paper and hit any key to continue"
  84. 7103  Y$=INKEY$:IF Y$="" THEN 7103
  85. 7104  PRINT #2,  TAB(35);"-";K;" -":PRINT #2,:PRINT #2, :MP=6:GOTO 7110
  86. 7105  MP2=MP1-MP+12:FOR J= 1 TO MP2:PRINT #2,:NEXT J:PRINT #2, TAB(35);"- ";K;" -":PRINT #2,:PRINT #2,:MP=6
  87. 7110  A$=RIGHT$(D$(I),V(1,I))+" "+LEFT$(D$(I),V(2,I)):N1=LEN(A$):N1=35-N1
  88. 7111  IF I+NM>NN THEN V$(1)="":V$(2)=""
  89. 7112  IS$=STR$(I):IS1$=STR$(I+NM):IF I<=9 THEN IS$="  "+IS$
  90. 7113  IF I+1<=9 THEN IS1$=" "+IS1$
  91. 7114  IF I>9 AND I<100 THEN IS$=" "+IS$
  92. 7115  IF I+1>9 AND I<100 THEN IS1$=" "+IS1$
  93. 7120  IF I+NM<=NN THEN PRINT #2, TAB(3);IS$;".  ";A$;SPACE$(N1);IS1$;".  ";RIGHT$(D$(I+NM),V(1,I+NM));" ";LEFT$(D$(I+NM),V(2,I+NM)):MP=MP+1:GOTO 7130
  94. 7125  PRINT #2, TAB(3);IS$;".  ";A$
  95. 7130  NEXT I
  96. 7132  PRINT #2, CHR$(12)
  97. 7135  RUN "ADMAIN.BAS"
  98. 7500  IF AX$="***" THEN 7505
  99. 7501  DIM DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  100. 7502  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  101. 7505  REM
  102. 7650  PRINT #2,
  103. 7660  PRINT #2, SPACE$(TN);T1$
  104. 7670  B=VAL(LEFT$(DATE$,2))
  105. 7680  PRINT #2,:PRINT #2, SPACE$(30);DQ$(B);" ";MID$(DATE$,4,2);", 19";RIGHT$(DATE$,2):PRINT #2,
  106. 7690  PRINT #2,
  107. 7700  MP =10
  108. 7710  RETURN
  109. 10000  IF SND$="N" THEN RETURN ELSE FOR A%=1 TO 3:SOUND 1000*A%,1:NEXT:FOR A%=3 TO 1 STEP -1:SOUND 1000*A%,1:NEXT:RETURN
  110. 10010  IF SND$="N" THEN RETURN ELSE FOR A%=1 TO 4:SOUND  500*A%,2:NEXT:RETURN
  111. 10020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  112.